Control .mesa 2-Sep-78 12:59:59 Page 



-- file Control .Mesa 

-- last modified by Sweet, July 20, 1978 2:30 PM 

DIRECTORY 

AllocDefs: FROM "allocdefs" USING [MakeDataSegment] , 

AltoDefs: FROM "altodefs" USING [CharsPerPage, PageSize], 

CompilerDefs: FROM "compilerdef s" 
USING [ 

Passl, Pass2, Pass3, Pass4, Code, Passlndex, 

PlUnit, P2Unit, P3Unit, P4Unit, P5module, 

CloseXref Journal , EndObjectFile, NTableDivisions , OpenXref Journal , 

PrintBodies, PrintSymbols , PrintTree, SetObjectStamp, 

StartObjectFile, TableOut], 

ComData: FROM "comdata" 
USING [ 

compilerVersion, def initionsOnly, dStar, errorStream, linkCount, 
netNumber, nErrors, nWarnings, objectBytes, objectFrameSize, 
objectStream, objectVersion , ownSymbols, rootFile, sort, 
sourceFile, sourceStream, warnings, xref], 

ControlDefs: FROM "controldef s" USING [Global FrameHandle], 

CopierDefs: FROM "copierdefs" USING [FilePacklnit , FilePackReset, OwnFile], 

DisplayDefs: FROM "displaydef s" USING [DisplayOff, DisplayOn, InitDisplay] , 

ErrorDefs: FROM "errordefs" USING [error], 

ErrorTabDefs: FROM "errortabdef s" USING [CSRptr], 

FontDefs: FROM "Fontdefs" USING [CreateFont], 

FrameDefs: FROM "framedefs" USING [SwapOutCode], 

ImageDefs: FROM "imagedefs" 
USING [ 

Cleanupltem, CleanupMask, CleanupProcedure, FileRequest, 
AddCleanupProcedure, AddFileRequest, ImageVersion, 
AbortMesa, Runlmage, StopMesa], 

InlineDefs: FROM "in! inedef s" USING [DIVMOD], 

IODefs: FROM "iodefs" 
USING [ 

ControlD, CR, SP, NumberFormat, ReadChar, ReadID, Rubout, WriteChar, 
WriteDecimal , WriteLine, WriteNumber, WriteOctal, Wri teString] , 

LitDefs: FROM "litdefs" USING [Li tTabErase , LitTablnit], 

MiscDefs: FROM "miscdefs" USING [CallDebugger , GetNetworkNumber], 

OsStaticDefs: FROM "osstaticdef s" USING [OsStatics], 

SegmentDef s : FROM "segmentdef s" 
USING [ 

FileHandle, DataSegmentHandle, FileSegmentHandle, PageCount, 
Append, Read, Write, DefaultBase, Def aul tPages, Defaul tVersion, 
CopyDataToFileSegment, DeleteDataSegment, LockFile, MoveFileSegment, 
NewFile, NewFileSegment , SegmentAddress, SegmentFaul t, SetEndOf File, 
SwapError, Swapln, SwapOut, Unlock], 

StreamDefs: FROM "streamdefs" 
USING [ 

StreamHandle, Streamlndex, Append, Read, Write, 

CloseDiskStream, CreateByteStream, GetDefaultDisplayStream, Getlndex, 

Modifylndex, NewByteStream, OpenDiskStream, Setlndex], 

StringDefs: FROM "stringdefs" 
USING [ 

AppendChar, AppendString, EquivalentString, 
MesaToBcpl String, Words ForBcpl String], 

SystemDefs: FROM "systemdef s" 

USING [AllocateHeapNode, Al locateHeapString, FreeHeapString, PruneHeap], 

SymbolTable: FROM "symboltable" , 

SymbolTableDefs: FROM "symbol tabledefs" 

USING [RestartSymbolCache, SuspendSymbolCache], 

SymTabDefs: FROM "symtabdefs" USING [symtaberase, symtabinit], 

TableDefs: FROM "tabledefs" 

USING [Region, EraseTable, Initial izeTable, TableFailure, TableOverf low], 

TimeDefs: FROM "timedefs" USING [Def aul tTime, AppendDayTime, UnpackDT], 

TrapDefs: FROM "trapdefs" USING [SendMsgSignal ] , 

TreeDefs: FROM "treedefs" USING [TreeLink, mlpop, TreeErase, Treelnit]; 

Control: PROGRAM [ 

creationTime: STRING, 
creator: ControlDefs. Global FrameHandle, 
parseTableSeg: SegmentDef s. FileSegmentHandle, 
stringTableSeg: SegmentDef s .FileSegmentHandle] 
IMPORTS 

AllocDefs, CompilerDefs, CopierDefs, DisplayDefs, ErrorDefs, FontDefs, 
FrameDefs, ImageDefs, IODefs, LitDefs, MiscDefs, SegmentDefs, 
StreamDefs, StringDefs, SymbolTableDefs, SymTabDefs, SystemDefs, 
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TableDefs, TimeDefs, TrapDefs, TreeDefs, 

ownSymbols: SymbolTable, dataPtr: ComData 
EXPORTS CompilerDefs SHARES ControlDefs, ImageDefs - 
BEGIN 
OPEN StreamDefs; 

-- overlay control 

Passlndex: TYPE ■ CompilerDefs. Passlndex; 
GlobalFrameHandle: TYPE ■ ControlDefs. GlobalFrameHandle; 

PassLink: TYPE - RECORD [ 
frame: GlobalFrameHandle, 
link: POINTER TO PassLink]; 

passRoot: ARRAY Passlndex OF POINTER TO PassLink; 

LoadPass: PROCEDURE [pass: Passlndex] ■ 
BEGIN 

p: POINTER TO PassLink; 

IF "initialized THEN Initial izeSwapping[]; 
FOR p ♦- passRoot[pass], p. link UNTIL p ■ NIL 

DO OPEN SegmentDefs; 

-- Don't use SwapInCode, it will mess up Start Traps 

SwapIn[p.frame.codesegment]; 

Unlock [p. frame. code segment]; 

ENDLOOP; 
RETURN 
END; 

UnloadPass: PROCEDURE [pass: Passlndex] - 
BEGIN 

p: POINTER TO PassLink; 

IF -initialized THEN Initial izeSwapping[] ; 
FOR p <- passRoot[pass], p. link UNTIL p ■ NIL 

DO 

FrameDefs.SwapOutCode[p. frame ISegmentDef s.SwapError «> CONTINUE]; 

ENDLOOP; 
[] <- SystemDef s.PruneHeap[] ; 
RETURN 
END; 

initialized: BOOLEAN <- FALSE; 

Initial izeSwapping: PROCEDURE - 
BEGIN 

i * Pcisslndsx* 

FOR i IN Passlndex DO passRoot[i] «- NIL ENDLOOP; 
initialized <- TRUE; RETURN 
END; 

MakeSwappable: PUBLIC PROCEDURE [module: PROGRAM, pass: Passlndex] « 
BEGIN 

frame: GlobalFrameHandle * LOOPHOLE[module]; 

p: POINTER TO PassLink » SystemDef s .AllocateHeapNode[SIZE[PassLink]]; 
q: POINTER TO PassLink; 

IF -initialized THEN Initial izeSwapping[]; 
pt <- PassLink[f rame:f rame, link:NIL]; 
IF passRoot[pass] ■ NIL 
THEN passRoot[pass] <- p 
ELSE 

BEGIN q <- passRoot[pass]; 

UNTIL q.link - NIL DO q «- q.link ENDLOOP; 

q.link *• p; 

END; 
RETURN 
END; 



-- command line input control 

commandStream: StreamHandle; 

comCmRequest : short ImageDefs. FileRequest *- [ 

body: short[fill:, name: "Com. Cm."], 

file: NIL, 

access: Read, 
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link: ]; 

SetCommandlnput: PROCEDURE ■ 
BEGIN 

c: CHARACTER; 

IF comCmRequest.f ile - NIL 
THEN commandStream <- NIL 
ELSE 

BEGIN OPEN IODefs; 

SegmentDefs.LockFile[ comCmRequest.f ile]; 

commandStream «- CreateByteStream[comCmRequest .f ile, Read]; 

[] <- SkipStreamBlanks[]; 

UNTIL commandStream. endof [commandStream] OR 

(c*-commandStream.get[commandStream]) ■ SP OR c ■ CR DO NULL ENDLOOP; 
[] *- SkipStreamBlanks[]; 
IF commandStream. endof [commandStream] THEN 

BEGIN commandStream. destroy[commandStream]; commandStream <- NIL; END 
ELSE Setlndex[ commandStream, ModifyIndex[Ge tin dex[ commandStream] ,-1]]; 
END; 
RETURN 
END; 

SkipStreamBlanks: PROCEDURE RETURNS [c: CHARACTER] - 
BEGIN OPEN IODefs; 
UNTIL commandStream. endof [commandStream] 

DO 

c «- commandStream. get[commandStream] ; 

IF c # SP AND c # CR THEN EXIT; 

ENDLOOP; 
END; 

CommandLinelD: PROCEDURE [s: STRING] • 
BEGIN OPEN IODefs; 
c: CHARACTER; 
s. length <- 0; 
c «- SkipStreamBlanks[]; 

IF commandStream. endof [commandStream] THEN RETURN; 
UNTIL c » SP OR c ■ CR DO 

StringDef s .AppendChar[s , c]; WriteChar[c] ; 

IF commandStream, endof [commandStream] THEN EXIT; 

c <- commandStream. get[commandStream] ; 

ENDLOOP; 
RETURN 
END; 

-- special output stream control 

ds: StreamHandle; 

displayPut: PROCEDURE [StreamHandle, CHARACTER]; 

typescript: StreamHandle; 

mtName: STRING = "Mesa.TypeScript . " ; 

mesaTSRequest: short ImageDef s.FileRequest «• [ 

body: short[fill: f name: mtName], 

file: NIL, 

access: SegmentDef s.Write+SegmentDefs. Append, 

link: ]; 

SetTypescript: PROCEDURE - 
BEGIN 

IF commandStream ■ NIL 
THEN typescript <- NIL 
ELSE 

BEGIN OPEN SegmentDef s; 

IF mesaTSRequest. file » NIL 

THEN mesaTSRequest. file <- NewFile[mtName, Write+Append, Defaul tVersion] ; 
typescript <- CreateByteStream[mesaTSRequest.f ile, Write+Append]; 
displayPut *- ds.put; ds.put <- SplitPut; 
END; 
RETURN 
END; 

SplitPut: PROCEDURE [s: StreamHandle, c: CHARACTER] - 
BEGIN 
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typescript. put[typescript, c]; displayPut[s, c]; RETURN 
END; 

savedPut: PROCEDURE [StreamHandle, CHARACTER]; 

ErrlogPut: PROCEDURE [s: StreamHandle, c: CHARACTER] ■ 
BEGIN 

errorFile: STRING; 
IF dataPtr .errorStream » NIL 
THEN 

BEGIN 

errorFile ♦- 

SystemDef s. All ocateHeapString[dataPtr . rootFile. length + (".errlog"L) . length] ; 

StringDef s. Appends tring[ errorFile, d at aPtr. rootFile]; 

StringDef s .AppendString[errorFile, " .errlog"L] ; 

dataPtr. errorStream <- NewByteStream[errorFile, Write+Append]; 

WriteHerald[errorFile]; 

SystemDef s.FreeHeapString[errorFile] ; 

END; 
dataPtr. errorStream. put [dataPtr. errorStream, c]; 
RETURN 
END; 

WriteHerald: PROCEDURE [id: STRING] ■ 
BEGIN OPEN TimeDefs, IODefs; 
now: STRING «- [20]; 

WriteString ["Alto/Mesa Compiler 4.1 of "L]; 
IF creationTime # NIL THEN WriteString[creationTime]; 
WriteChar[CR]; 

Ap pen dDay Time [now, UnpackDT[Defaul tTime]]; 

IF id # NIL THEN BEGIN WriteString[id] ; WriteString[" — "L] END; 
WriteLine[now]; 
RETURN 
END; 

WriteTime: PROCEDURE [sec: CARDINAL] - 
BEGIN OPEN IODefs; 
hr, min: CARDINAL; 
f: NumberFormat <- [base:10, unsigned:TRUE, zerof ill : FALSE, columns:!.]; 

W: PROCEDURE [t: CARDINAL] - 
BEGIN 
IF t # OR f.zerofill THEN 

BEGIN 

WriteNumber[t, f]; WriteChar[ ' :]; 

f «- [base:10, unsigned:TRUE , zerof il 1 :TRUE, columns:2]; 

END; 
END; 

[min, sec] «- In! ineDef s.DIVMOD[sec, 60]; 
[hr, min] <- In! ineDef s .DIVMOD[min, 60]; 
W[hr]; W[min]; WriteNumber[sec, f]; 
END; 

WriteClosing: PROCEDURE • 
BEGIN OPEN IODefs; 

WriteChar[CR]; WriteString[sourceFile]; WriteString[" — M L]; 
IF aborted 
THEN 

BEGIN errors <- TRUE; 
WriteString["aborted, M L]; 

WriteDecimal[dataPtr .nErrors]; WriteString[" errors "L]; 
IF dataPtr .nWarnings # 
THEN 

BEGIN WriteString[ M and "L]; 

WriteDecimal[dataPtr .nWarnings]; Wr iteString[" warnings "L]; 
END; 
WriteString["on M L]; 

WriteString[dataPtr. rootFile]; WriteString[" .errlog"L]; 
END 
ELSE 
BEGIN 

WriteString["source chars: "L]; 
WriteNumber[sourceChars, 

[base: 10, zerof ill : FALSE, unsigned: TRUE, columns: 1]]; 
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WriteString[\ time: f, L]; 
WriteTime[ second sClock. low~moduleStartTime]; 
IF ~dataPtr.definitionsOnly 
THEN 
BEGIN 

WriteChar[CR]; 

WriteString[" code bytes: "L]; WriteDecimal[dataPtr .objectBytes]; 
WriteString[", links: M L]; WriteDecimal[dataPtr .1 inkCount]; 
WriteString[", frame size: "L]; 
WriteDecimal[dataPtr .object FrameSize]; 
END; 
IF dataPtr.nWarnings # THEN 

BEGIN warnings <- TRUE; WriteChar[CR] ; 

WriteDecimal[dataPtr.nWarnings]; WriteString[" warnings on "L]; 
WriteString[dataPtr .rootFile]; WriteString[" .errlog"L]; 
END; 
END; 
RETURN 
END; 

sourceChars: CARDINAL; 

SaveSourceLength: PROCEDURE - 
BEGIN OPEN StreamDefs; 

i: Streamlndex » GetIndex[dataPtr.sourceStream]; 
sourceChars <- i .page*Al toDef s.CharsPerPage+i .byte; 
RETURN 
END; 

-- display control 

sysFontRequest: short ImageDef s.FileRequest «- [ 
body: short[fill:, name: "SysFont.al ."], 
file: NIL, 
access: Read, 
link: ]; 

-- cursor control 

Cursor: TYPE - MACHINE DEPENDENT RECORD [ 
top: PRIVATE CursorRow, 
rowl: CursorRow, 
ml2: PRIVATE CursorFill, 
row2: CursorRow, 
m23: PRIVATE CursorFill, 
row3: CursorRow, 
bottom: PRIVATE CursorRow]; 

TheCursor: POINTER TO Cursor « L00PH0LE[431B] ; 
savedCursor; Cursor; 

CursorRow: TYPE = ARRAY [0. .2) OF WORD; 
CursorFill: TYPE - ARRAY [0..3) OF WORD; 

Two: CursorRow « [147763B, 147763B]; 
LI: CursorRow - [147777B, 147777B]; 
Rl: CursorRow * [177763B, 177763B]; 
Ml: CursorRow - [177177B, 177177B]; 

ClearCursor: PROCEDURE ■ 
BEGIN 

i: CARDINAL; 

FOR i IN [431B .. 431B+16) DO MEMORY[i] <- -1 ENDLOOP; 
RETURN 
END; 

-- cleanup of files/streams 

compilerCleanupItem: ImageDef s.CleanupItem +• [ 
proc: CompilerCleanup, 

mask: ImageDef s.CleanupMask[InLd] + ImageDefs .CleanupMask[OutLd], 
link: ]; 

CompilerCleanup: ImageDefs. CleanupProcedure * 
BEGIN 
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SELECT why FROM 
OutLd ■> 

IF dataPtr .errorStream # NIL 

THEN C 1 os eDiskStream[dataPtr . errorStream]; 
InLd »> 

IF dataPtr. errorStream # NIL 

THEN OpenDiskStream[d a taPtr. errorStream]; 
ENDCASE; 
RETURN 
END; 

-- table storage management 

tableRequest: short ImageDef s . FileRequest *- [ 
body: short[fill:, name: "Swatee."], 
file: NIL, 

access: Read+Write+Append, 
link: ]; 

PageCount: TYPE * SegmentDefs . PageCount; 

TablePageStart: PageCount ■ 64; 
TablePageStep: PageCount a 8; 
TablePageLimit: PageCount ■ 96; 

tableDataSegment: SegmentDefs .DataSegmentHandle; 
tableFileSegment: SegmentDefs . FileSegmentHandle; 
tablePages: PageCount; 

tableRegion: TableDefs. Region; 

LoadTable: PROCEDURE [nPages: PageCount] * 
BEGIN 

OPEN SegmentDefs; 
IF nPages # tablePages 
THEN 
BEGIN 

IF tableFileSegment * NIL 
THEN 
BEGIN 

IF tableRequest. file = NIL THEN 
tableRequest. file «- 

NewFile["Swatee.", Read+Write+Append, Defaul tVersion]; 
tableFileSegment «- NewFileSegment[ 
file: tableRequest. file, 
base: DefaultBase, 
pages: tablePages, 
access: Read+Write]; 
CopyDataToFileSegment[ tableDataSegment, tableFileSegment 
! SegmentFault a > 
BEGIN 

SetEndOf File[ tableRequest. file, tableFileSegment .base+nPages, 0]; 
RETRY 
END]; 
DeleteDataSegment[tableDataSegment] ; tableDataSegment «- NIL; 
END 
ELSE 

BEGIN Unlock[ tableFileSegment]; SwapOut[tableFileSegment] END; 
MoveFileSegment[tableFileSegment , DefaultBase, nPages]; 
tablePages «- nPages; 

SwapIn[tableFileSegment ! SegmentFault ■> 
BEGIN 

Se t En dOfFile[ tableRequest. file, tableFileSegment.base+n Pages, 0]; 
RETRY 
END]; 
END; 
tableRegion *- [ 

origin: LOOPHOLE[SegmentAddress[IF tableDataSegment it NIL 
THEN tableDataSegment ELSE tableFileSegment]], 
size: tablePages*Al toDef s.PageSize]; 
RETURN 
END; 

■- string table management 
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tableLocked: BOOLEAN <- FALSE; 

OpenStringTable: PUBLIC PROCEDURE RETURNS [ErrorTabDef s.CSRptr] - 
BEGIN 

IF tableLocked THEN ERROR; 
SegmentDefs.SwapIn[stringTableSeg]; 
tableLocked ♦■ TRUE; 

RETURN [LOOPHOLE[SegmentDefs.SegmentAddress[stringTableSeg]]]; 
END; 

CloseStringTable: PUBLIC PROCEDURE - 
BEGIN 

IF tableLocked 
THEN 
BEGIN 

SegmentDefs.Unlock[stringTableSeg]; tableLocked <- FALSE; 
END; 
RETURN 
END; 

-- compiler sequencing 

Initialize: PROCEDURE * 
BEGIN 

dataPtr.errorStream «- dataPtr.objectStream *- NIL; 
dataPtr.sourceStream.reset[dataPtr.sourceStream]; 
savedPut <- ds.put; ds.put <- ErrlogPut; 
IF typescript # NIL THEN CloseDiskStream[typescript]; 
IF commandStream # NIL THEN CloseDiskStream[commandStream]; 
DisplayDefs.Disp layoff [black]; 
savedCursor «- TheCursort; ClearCursor[]; 
LoadTable[TablePageStart]; 

TableDef s .Initial izeTable[tableRegion, CompilerDef s . NTableDi vis ions]; 
SymTabDefs.symtabinit[]; LitDef s.LitTabInit[]; TreeDef s.TreeInit[]; 
RETURN 
END; 

Finalize: PROCEDURE ■ 
BEGIN 
IF dataPtr.objectStream # NIL 

THEN CompilerDefs.EndObjectFile[dataPtr.nErrors=0]; 
TreeDef s.TreeErase[]; LitDef s. Li tTabErase[] ; SymTabDef s.symtaberase[] ; 
TableDef s .EraseTable[]; 
TheCursort <- savedCursor; 
DisplayDefs.DisplayOn[]; 

IF commandStream # NIL THEN OpenDiskStream[commandStream]; 
IF typescript # NIL THEN OpenDiskStream[ typescript] ; 
ds.put «- savedPut; 
IF dataPtr.errorStream NIL 

THEN dataPtr .err or St ream. destroy [dataPtr.errorStream]; 
IF pass # '1 THEN OpenDiskStream[dataPtr . sourceStream] ; 
dataPtr.sourceStream.destroy[dataPtr. sour ceSt ream]; 
RETURN 
END; 

StopCompiler: PROCEDURE * 
BEGIN 

IF moduleCount > 1 THEN 
BEGIN OPEN IODefs; 

WriteChar[CR]; Wr iteString["Total elapsed time: "L]; 
WriteTime[secondsClock. low-compilerStartTime] ; 
WriteChar[CR]; 
END; 
IF typescript # NIL 
THEN 

BEGIN ds.put *- displayPut; typescript. destroy[typescript]; 
IF (errors OR warnings) AND pauseForErrors 
THEN 

BEGIN OPEN IODefs; 
WriteChar[CR]; 
IF errors THEN 
BEGIN 

WriteString["Errors M L]; 
IF warnings THEN WriteString[" and H L]; 
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END; 
IF warnings THEN WriteString["Warnings M L]; 
WriteString[" logged; type any character to finish. M L]; 
[] <- ReadChar[]; WriteChar[CR]; 
END; 
END; 
RETURN 
END; 

debugPass: Passlndex ♦■ debug; 

Debug: PROCEDURE [tree, symbols: PROCEDURE] - 
BEGIN 

LoadPass[debug]; 
tree[]; symbols[]; 

CloseStringTable[]; Unload Pass [debug]; RETURN 
END; 

PrintTreeRoot: PROCEDURE - BEGIN CompilerDef s .PrintTree[root] ; RETURN END; 

sourceFile: STRING <- [40]; 

sortDefault, warningsDef aul t, xrefDefault, dStarDefaul t: BOOLEAN; 
debugDefault: BOOLEAN; 

debugFlag, pauseForErrors, localPause: BOOLEAN; 
pass: CHARACTER ['l..^]; 
nParseErrors: CARDINAL; 

parsed, aborted, errors, warnings: BOOLEAN; 
moduleCount: CARDINAL *- 0; 

moduleStartTime, compilerStartTime: CARDINAL; 

secondsClock: POINTER TO MACHINE DEPENDENT RECORD [high, low: CARDINAL] « 
LOOPHOLE[572B]; 

objectFileHint: SegmentDef s .FileHandle; 

msg, signal: UNSPECIFIED; 

root: TreeDef s.TreeLink; 



_.****** MAIN BODY CODE ****** 

-- add cleanup procedure 
ImageDefs .AddCleanupProcedu re [©compiler Cleanup Item]; 
ImageDef s . AddFileRequest[@comCmRequest]; 
ImageDefs. AddFileRequest[@mesaTSRequestj; 
ImageDefs .AddFileRequest[@sysFontRequestj; 
ImageDefs ,AddFileRequest[@tableRequest]; 
STOP; -- wait for restart 

START dataPtr; -- initialize STRING variables, etc. 
START ownSymbols; -- initialize STRING variables, etc. 



dataPtr. sourceFile <■ 
dataPtr .ownSymbols <• 
dataPtr .errorStream 



sourceFile; 
ownSymbols; 
r NIL; 



-- shared string body 



-- set up swapping 
BEGIN OPEN CompilerDefs; 

MakeSwappable[Passl, passl]; --START Passl 
MakeSwappable[Pass2, pass2]; --START Pass2 
MakeSwappable[Pass3, pass3]; --START Pass3 
MakeSwappable[Pass4, pass4]; --START Pass4 
MakeSwappable[Code, pass5]; --START Code; 
END; 



UnloadPass[passl] ; 
Un1oadPass[pass2]; 
UnloadPass[pass3]; 
UnloadPass[pass4] ; 
UnloadPass[pass5]; 



compilerStartTime <- secondsClock. low; 

-- start the display 
BEGIN OPEN SegmentDef s; 
IF sysFontRequest.file - NIL THEN ERROR; 
DisplayDefs.InitDisplay[ 
dummySize: 72, 
textLines: 6, 
nPages: 6, 
f: FontDefs.CreateFont[ 

NewFileSegment[sysFontRequest.f ile, 1, Defaul tPages, Read]]]; 
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END; 

-- consider deleting the compiler builder here 

dataPtr .compilerVersion <- ImageDefs. ImageVersion[]; 
dataPtr.netNumber *- MiscDef s.GetNetworkNumber[]; 

-- obtain the scratch area 
tableDataSegment <- AllocDef s.MakeDataSegment[ 

base: SegmentDef s. Def aul tBase, 

pages: TablePageStart, 

info: [0, easy, bottomup, initial, other, FALSE, FALSE]]; 
tablePages *- TablePageStart; 
tableFileSegment <- NIL; 

-- do the compilation 
sortDefault «- warningsDefaul t «- TRUE; 
debugDefault ♦• xrefDefault 4- dStarDefault «- FALSE; 
pauseForErrors «- TRUE; 
SetCommandInput[]; 
ds <- GetDef aul tDisplayStream[]; 
SetTypescript[]; WriteHerald[NIL]; errors <- warnings ♦■ FALSE; 

DO 

OPEN IODefs; 

BEGIN 

i, sourceLength: CARDINAL; 

sense, sourceExtension: BOOLEAN; 

CompleteFileName: PROCEDURE RETURNS [fileName: STRING, bcpl : BOOLEAN] - 
BEGIN OPEN StringDefs; 
j: CARDINAL; 

extension: STRING <- [40]; 

fileName *- SystemDef s .A11ocateHeapString[40]; 
AppendString[f ileName, dataPtr. rootFile]; 
IF ^sourceExtension 

THEN AppendString[extension, M image"L] 

ELSE 

FOR j IN [dataPtr . rootFile. length+1 .. sourceLength) 
DO AppendChar[extension, sourceFile[ j]] ENDLOOP; 
bcpl 4- EquivalentString[extension, "run"L]; 
AppendChar[f ileName, '.]; AppendString[f ileName, extension]; 
RETURN 
END; 

WriteCommandFile: PROCEDURE [fileName: STRING] - 
BEGIN 

j: CARDINAL; 
copy: StreamHandle; 

copy 4- CreateByteStream[comCmRequest.f ile, Write+Append]; 
FOR j IN [0. .fileName. length) DO copy . put[copy , TileName[j]] ENDLOOP; 
IF sourceFile. length > i+1 
THEN 
BEGIN 

copy.put[copy, '/]; 
FOR j IN (i . .sourceFile. length) 

DO copy.put[copy, sourceFile[j]] ENDLOOP; 
END; 
IF commandStream ■ NIL OR commandStream.endof [commandStream] 
THEN copy.put[copy, CR] 
ELSE 
BEGIN 

copy.put[copy, ' ]; 
UNTIL commandStream.endof [commandStream] 

DO copy.put[copy, commandStream. get[commandStream]] ENDLOOP; 
END; 
IF commandStream # NIL THEN commandStream. destroy[commandStream]; 
copy. destroy [copy]; 
RETURN 
END; 

Run: PROCEDURE [fileName: STRING, bcpl: BOOLEAN] - 
BEGIN 
IF bcpl 
THEN 
BEGIN 
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p: POINTER ■ OsStaticDef s .OsStatics . EventVector; 
EVItem: TYPE - MACHINE DEPENDENT RECORD [ 

type: [0..7777B], length: [0..17B]]; 
pt <- EVItem[6, StringDef s .WordsForBcplString[f ileName. length]+l]; 
StringDef s.MesaToBcpl String [fileName, p+1]; 
ImageDef s.StopMesa[] ; 
END 
ELSE 
BEGIN 

OPEN SegmentDefs; 
ImageDef s. Run Image [NewFileSegment[ 

file: NewFile[f ileName, Read, Def aul tVersion], 

base: 1, 

pages: 1, 

access: Read]]; 
END; 
END; 

dataPtr.xref «- xrefDefault; dataPtr .warnings «- warningsDef aul t ; 
dataPtr.sort «- sortDefault; dataPtr . dStar «- dStarDefaul t; 
debugFlag <- debugDef aul t; localPause <- FALSE; 
WriteChar[CR]; WriteString[ M Conpile: "]; 
IF commandStream # NIL 

THEN CommandLineID[sourceFile] 
ELSE ReadID[sourceFile IRubout »> GO TO abort]; 
IF sourceFile. length * THEN EXIT; 

IF sourceFile[0] a ControlD THEN GO TO debugger; -- tD «> debug 
moduleStartTime *- secondsClock. low; 

dataPtr. rootFile. length «- 0; sourceExtension <- FALSE; 
FOR i IN [0. .sourceFile. length) 
DO 
SELECT sourceFile[i] FROM 

'. => sourceExtension «- TRUE; 
'/ »> GO TO Switches; 
ENDCASE; 
IF ~sourceExtension 

THEN StringDef s . AppendChar[dataPtr . rootFile, sourceFile[i]]; 
REPEAT 

Switches «> 
BEGIN 

sourceLength «- i ; i <- 1+1; sense <- TRUE; 
WHILE i < sourceFile. length 
DO 

SELECT sourceFile[i] FROM 
'-, '~ => sense «- -sense; 

'a, 'A => BEGIN dataPtr .dStar <- -sense; sense <- TRUE END; 
'd, 'D »> BEGIN debugFlag «- sense; sense «- TRUE END; 
'p, 'P => BEGIN localPause «- sense; sense ♦- TRUE END; 
•r, 'R «> 
BEGIN 

fileName: STRING; 
bcpl: BOOLEAN; 

[fileName, bcpl] «- CompleteFileName[]; 
WriteCommandFile[f ileName]; 
StopCompiler[]; 

Run[f ileName, bcpl 1 ANY *> ImageDef s .AbortMesa]; 
-- never returns 
END; 
's, 'S *> BEGIN dataPtr.sort ♦- sense; sense <- TRUE END; 
'w, 'W => BEGIN dataPtr .warnings «- sense; sense «- TRUE END; 
'x, 'X = > BEGIN dataPtr.xref <- sense; sense «- TRUE END; 
IN ['!.. '5] »> 
BEGIN 

debugPass «- LOOPHOLE[sourceFile[i]- * 0]; sense <~ TRUE; 
END; 
'c, *C «> 
BEGIN sense <- TRUE; 
FOR i IN [0. .sourceLength) 
DO 

SELECT sourceFile[i] FROM 
*-, '- B > sense <- -sense; 

dStarDefault <- -sense; EXIT END; 
debugDefault <- sense; EXIT END; 
pauseForErrors <- sense; EXIT END; 
sortDefault «- sense; EXIT END; 
warningsDefault «- sense; EXIT END; 



'a, 


»A «> BEGIN 


*d, 


'D -> BEGIN 


'P. 


•P «> BEGIN 


's, 


'S »> BEGIN 


'w, 


•W »> BEGIN 
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'x, 'X ■> BEGIN xrefDefault <- sense: EXIT END; 
IN ['1..'5] «> 
BEGIN 

debugPass <- L00PH0LE[sourceFile[i]-'0]; EXIT 
END; 
ENDCASE -> EXIT; 
ENDLOOP; 
GO TO skip 
END; 
ENDCASE; 
i ♦- 1 + 1; 
ENDLOOP; 
END; 
FINISHED ■> sourceLength <- sourceFile. length; 
ENDLOOP; 
sourceFile. length «- sourceLength; 
IF ~sourceExtension THEN StringDefs. AppendString[sourceFile, ".mesa"]; 

moduleCount <- moduleCount + 1; 

dataPtr .sourceStream <- NewByteStream[sourceFile, Read 
1 ANY ■> GO TO noSource]; 

dataPtr.nErrors <- dataPtr.nWarnings «- 0; aborted «- FALSE; 
Initialize[]; 

BEGIN 
ENABLE 
BEGIN 

TableDefs.TableOverflow »> 
BEGIN 

IF tablePages >* TablePageLimit THEN GO TO outOfSpace; 
LoadTable[tablePages+TablePageStep]; RESUME[tableRegion] 
END; 
TableDefs.TableFailure => GO TO outOfSpace; 
UNWIND «> Finalize[]; 
ANY => IF -debugFlag 
THEN 
BEGIN 

[msg, signal] ♦■ SIGNAL TrapDef s.SendMsgSignal ; 
GO TO uncaughtSignal 
END 
END; 

-- first pass 
pass «- '1; LoadPass[passl]; 
TheCursor.row2 ♦■ Ml; 

parsed «- CompilerDef s.PlUnit[parseTableSeg]; 
nParseErrors <- dataPtr.nErrors; 
ClearCursor[]; UnloadPass[passl]; 
IF -parsed THEN GO TO failed; 
root ♦- TreeDefs.mlpop[]; 
SaveSourceLength[]; 

C 1 oseD iskStream[d a taPtr. sourceStream]; 
IF debugPass <« passl 

THEN Debug[PrintTreeRoot, CompilerDef s.PrintSymbols]; 

-- second pass 
pass <- '2; LoadPass[pass2] ; 
TheCursor .rowl ♦- LI; TheCursor.row3 <- Rl; 
root *- CompilerDefs.P2Unit[root]; 
ClearCursor[]; UnloadPass[pass2]; 
IF debugPass <■ pass2 

THEN Debug[PrintTreeRoot, CompilerDef s .PrintSymbols]; 
IF dataPtr.nErrors # THEN dataPtr.xref <- FALSE; 

-- third and fourth passes 
ComptlerDefs.SetObjectStamp[]; 

CopierDef s .FilePackInit[dataPtr .rootFile, dataPtr .objectVersion]; 
objectFileHint <- NIL; 
BEGIN 
ENABLE 
BEGIN 

TableDefs.TableOverflow -> 
BEGIN 

IF tablePages >- TablePageLimit THEN GO TO noSpace; 
Symbol Tab leDefs.SuspendSymbo!Cache[]; 
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LoadTable[tablePages+TablePageStep]; 

Symbol Tab leDefs. Res tar tSymbolCache[]; 

RESUME[tableRegion] 

END; 
CopierDefs. OwnFile -> BEGIN objectFileHint «- file; RESUME END 
END; 

IF dataPtr.xref THEN CompilerDefs.OpenXref Journal[] ; 

pass <- '3; LoadPass[pass3] ; 

TheCursor.rowl <- Rl; TheCursor. row2 <- Ml; TheCursor ,row3 <- LI; 

root «- CompilerDef s.P3Unit[root]; 

ClearCursor[]; UnloadPass[pass3]; 

IF dataPtr.xref THEN CompilerDefs.CloseXref Journal[]; 
IF debugPass <■ pass3 

THEN Debug[PrintTreeRoot, CompilerDef s .PrintSymbols]; 
IF dataPtr.nErrors > nParseErrors THEN GO TO DeleteFiles; 

dataPtr.objectStream 4- CompilerDef s. Star tObjectFil e[objectFi leHint] ; 

pass <- '4; LoadPass[pass4] ; 
TheCursor.rowl «- TheCursor. row3 <- Two; 
CompilerDefs.P4Unit[root]; 
ClearCursor[]; UnloadPass[pass4]; 
IF debugPass < a pass4 

THEN Debug [Comp il erDef s.Pr in tBodies, CompilerDef s.Pr in tSymbo Is] ; 
GO TO DeleteFiles; 

EXITS 

DeleteFiles -> CopierDefs ,FilePackReset[]; 

noSpace a > 

BEGIN CopierDefs. FilePackReset[]; GO TO outOfSpace END; 
END; 
IF dataPtr.nErrors # THEN GO TO failed; 

— fifth pass 
IF ~dataPtr.def initionsOnly 
THEN 
BEGIN 

ENABLE UNWIND => Compi 1 erDef s . EndObjectFile[FALSE] ; 
pass *- '5; LoadPass[pass5]; 

TheCursor.rowl <- TheCursor. row3 *• Two; TheCursor. row2 *- Ml; 
Compi 1 erDef s.P5module[]; 
ClearCursor[]; UnloadPass[pass5]; 
END; 

TheCursor.rowl <- TheCursor. row2 *- TheCursor. row3 «- Two; 

Comp il erDef s. Tab leOut[sourceFile] ; 

IF dataPtr.nErrors # THEN GO TO failed; 

EXITS 

failed => BEGIN aborted «- TRUE; CloseStringTable[] END; 
uncaughtSignal «> 

BEGIN aborted *- TRUE; 
IF pass a '1 

THEN WriteString["Compiler Error "] 
ELSE ErrorDefs . err or [compi 1 erError]; 
WriteString[ M Pass ■ "]; WriteChar[pass]; 
WriteString[" , signal = "]; WriteOctalfsignal]; 
WriteString[" , message ■ "]; WriteOctal[msg]; 
WriteChar[CR]; 
END; 
outOfSpace »> 

BEGIN aborted ♦• TRUE; 

WriteChar[CR]; Wri teString["Storage Overflow in Pass "]; 
WriteChar[pass]; WriteChar[CR]; 
END; 
END; 

Final ize[]; 

WriteClosing[]; 

EXITS 

skip ■> NULL; 
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abort ■> WriteString[" XXX"]; 
noSource ■> 

BEGIN errors «- TRUE; WriteString[" File error"] END; 
debugger ■> MiscDefs.CallDebugger[NIL]; 
END; 
WriteChar[CR]; 
IF (errors OR warnings) AND localPause THEN 

BEGIN pauseForErrors «- TRUE; GO TO truncateList END; 
REPEAT 

truncateList ■> NULL; 
ENDLOOP; 

StopCompiler[]; 

END. 



